home *** CD-ROM | disk | FTP | other *** search
/ Input 64 / Input_64_86-05_1986_Verlag_Heinz_Weise_de.d64 / arrays .lsp next >
Text File  |  2023-02-26  |  2KB  |  47 lines
  1. (array fexpr (nlambda l (putprop (car 
  2. l) (quote array) (dim (mapcar (quote 
  3. eval) (cddr l)) (eval (cadr l)))) (
  4. car l)))
  5. (lod fexpr (nlambda l (lod1 (getprop (
  6. car l) (quote array)) (mapcar (quote 
  7. eval) (cdr l)))))
  8. (sto fexpr (nlambda l (sto1 (getprop (
  9. car l) (quote array)) (eval (cadr l)) 
  10. (mapcar (quote eval) (cddr l)))))
  11. (dim expr (lambda (nlis e) (cond ((
  12. atom nlis) (copy e)) (t (build (car 
  13. nlis) (dim (cdr nlis) e))))))
  14. (build expr (lambda (n e) (cond ((
  15. zerop n) nil) (t (cons (copy e) (
  16. build (sub1 n) e))))))
  17. (sto1 expr (lambda (l e dims) (cond ((
  18. atom dims) nil) ((atom (cdr dims)) (
  19. rplaca (nth l (car dims)) e)) (t (
  20. sto1 (car (nth l (car dims))) e (cdr 
  21. dims))))))
  22. (lod1 expr (lambda (l dims) (cond ((
  23. atom dims) l) (t (lod1 (car (nth l (
  24. car dims))) (cdr dims))))))
  25. (for fexpr (nlambda l (prog (var fst 
  26. lst exprs test-fn count-fn) (setq var 
  27. (car l)) (setq fst (eval (cadr l))) (
  28. setq lst (eval (car (cddr l)))) (cond 
  29. ((lessp lst fst) (setq test-fn (quote 
  30. lessp)) (setq count-fn (quote sub1))) 
  31. (t (setq test-fn (quote greaterp)) (
  32. setq count-fn (quote add1)))) (setq 
  33. exprs (cdr (cddr l))) loop (cond ((
  34. test-fn fst lst) (return nil))) (set 
  35. var fst) (mapc (quote eval) exprs) (
  36. setq fst (count-fn fst)) (go loop))))
  37. (while fexpr (nlambda l (prog (con 
  38. exprs) (setq con (car l)) (setq exprs 
  39. (cdr l)) loop (cond ((eval con) (mapc 
  40. (quote eval) exprs) (go loop))))))
  41. (if fexpr (nlambda l (cond ((eval (
  42. car l)) (eval (cadr l))) (t (last (
  43. mapcar (quote eval) (cddr l)))))))
  44. (arrfns value (array lod sto dim 
  45. build sto1 lod1 for while if arrfns))
  46. nil
  47.